home *** CD-ROM | disk | FTP | other *** search
/ Netware Super Library / Netware Super Library.iso / pgm_tool / nwtp06 / scanbind.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-01  |  12.7 KB  |  382 lines
  1. {$X+,B-,V-,S-,I-} {essential compiler directives}
  2.  
  3. Program ScanBind;
  4.  
  5. { Example for the nwBindry unit / NwTP 0.6 API. (c) 1993,1995, R.Spronk }
  6.  
  7. { Purpose: Dumps the entire contents of the bindery. }
  8.  
  9. { Tests the following nwBindry calls:
  10.  
  11.   IsShellLoaded
  12.   GetBinderyAccessLevel
  13.   ScanBinderyObject
  14.   ScanProperty
  15.   ReadPropertyValue
  16.   GetRealUserName
  17. }
  18.  
  19. Uses nwMisc,nwBindry;
  20.  
  21. Type string30=string[30];
  22.      PobjRec =^objRec;
  23.      objRec  =Record
  24.               objId:LongInt;
  25.               name:string30;
  26.               next:PobjRec;
  27.               end;
  28.  
  29. Var PstartObj:Pobjrec;
  30.     GlobalPath:string;
  31.     f:text;
  32.  
  33. procedure WriteReadSecurity(sec:Byte);
  34. begin
  35. Case LoNibble(Sec) of
  36.    BS_ANY_READ       :write('Any (0)');
  37.    BS_LOGGED_READ    :write('Log (1)');
  38.    BS_OBJECT_READ    :write('Obj (2)');
  39.    BS_SUPER_READ     :write('Sup (3)');
  40.    BS_BINDERY_READ   :write('Netw(4)');
  41.    else writeln('Unknown. (Read Rights Flag=$',HexStr(LoNibble(Sec),2),')');
  42. end;{case}
  43. end;
  44.  
  45. Procedure WriteWriteSecurity(Sec:Byte);
  46. begin
  47. Case (HiNibble(Sec) SHL 4) of
  48.    BS_ANY_WRITE      :write('Any (0)');
  49.    BS_LOGGED_WRITE   :write('Log (1)');
  50.    BS_OBJECT_WRITE   :write('Obj (2)');
  51.    BS_SUPER_WRITE    :write('Sup (3)');
  52.    BS_BINDERY_WRITE  :write('Netw(4)');
  53.    else writeln('Unknown. (Write Rights Flag=$',HexStr(HiNibble(Sec) SHL 4,2),')');
  54. end; {case}
  55. end;
  56.  
  57. Procedure PutInLinkedList(objId:LongInt;objName:String;objType:Word);
  58. Var rp,np,lp:PobjRec;
  59.     lName   :string;
  60. begin
  61. lName:=objname;
  62. if lName[0]>#20
  63.  then lName[0]:=#20; { shorten object name; }
  64. New(np);
  65. if objType=OT_USER
  66.  then lname:=lname+' (User)'
  67.  else if objType=OT_USER_GROUP
  68.        then lname:=lname+' (Group)';
  69. np^.name:=lname;
  70. np^.objId:=objId;
  71. np^.next:=NIL;
  72. If PstartObj=NIL
  73.  then PstartObj:=np
  74.  else begin
  75.       lp:=PstartObj;
  76.       while (lp^.next<>NIL) do lp:=lp^.next;
  77.       lp^.next:=np;
  78.       end;
  79. end;
  80.  
  81. Function getNameFromLL(id:Longint):String;
  82. Var rp:PobjRec;
  83. begin
  84. rp:=PstartObj;
  85. While ((rp<>NIL) and (rp^.objId<>id)) do rp:=rp^.next;
  86. if rp=NIL then getNameFromLL:='!error: ID not found in stored ID List.'
  87.           else getNameFromLL:=rp^.name;
  88. end;
  89.  
  90. Procedure ShowSet(pset:Tproperty);
  91. Var i    :Byte;
  92.     objId:LongInt;
  93. begin
  94. { A segment of a set-property consists of a list of object IDs,
  95.   each ID 4 bytes long, stored hi-lo.
  96.   The end of the list (within THIS segment) is marked by an ID of 00000000. }
  97. i:=1;
  98. Repeat
  99.  objId:=MakeLong((pset[i] *256 +pset[i+1]), ( pset[i+2] *256 + pset[i+3] ) );
  100.  if objId<>0
  101.   then writeln('    *',GetNameFromLL(objId),'(',HexStr(objId,8),')');
  102.  inc(i,4);
  103. Until (i>128) or (objId=0);
  104. end;
  105.  
  106. Procedure DumpPropVal(DontSkipZeros:boolean;pv:Tproperty);
  107. Var t,g,skip:Byte;
  108.     c       :char;
  109.     s       :string;
  110. begin
  111. if DontSkipZeros
  112.  then skip:=7
  113.  else begin
  114.       skip:=128;
  115.       while (pv[skip]=$00) and (skip>1) do dec(skip);
  116.       skip:=(skip-1) DIV 16;
  117.       end;
  118. t:=0;
  119. While t<=skip
  120. do begin
  121.    s:='';
  122.    write('    *');
  123.    for g:=1 to 16
  124.    do begin
  125.       write(HexStr(pv[t*16+g],2),' ');
  126.       c:=chr(pv[t*16+g]);
  127.       if c>=' ' then s:=s+c else s:=s+' ';
  128.       end;
  129.    writeln(s);
  130.    inc(t);
  131.    end;
  132. end;
  133.  
  134.  
  135. Var lastObjSeen:LongInt;
  136.     objName    :String;
  137.     objType    :Word;
  138.     objId      :LongInt;
  139.     objFlag    :Byte;
  140.     objSec     :Byte;
  141.     objHasProp :Boolean;
  142.  
  143.     SecAccessLevel:Byte;
  144.     MyObjId       :LongInt;
  145.  
  146.     SeqNumber     :LongInt;
  147.     propName      :String;
  148.     propFlags,
  149.     propSecurity  :Byte;
  150.     propHasValue,
  151.     moreProperties:Boolean;
  152.  
  153.     SegNbr   :Byte;
  154.     propValue:Tproperty; { array[1..128] of byte }
  155.     accVal: record
  156.             balance :LongInt; {hi-lo}
  157.             limit   :LongInt;   {hi-lo}
  158.             Reserved:array[1..120] of byte; { NW internal info }
  159.             end ABSOLUTE PropValue;
  160.     holdVal: array[1..16]
  161.               of record
  162.                  AccountServerID:Longint; {hi-lo}
  163.                  HoldAmount     :LongInt; {hi-lo}
  164.                  end ABSOLUTE PropValue;
  165.     holds  :Longint;
  166.     moreSeg:boolean;
  167.  
  168.     t         :word;
  169.     tempString:String;
  170.  
  171.     OTfileFound:Boolean;
  172.     ObjTypeStr,s:string;
  173.  
  174. begin
  175. Writeln('ScanBind V1.2');
  176. Writeln('Provides information about all accessible bindery objects.');
  177.  
  178. GlobalPath:=ParamStr(0);
  179. while NOT (GlobalPath[ord(GlobalPath[0])] IN [':','\','/'])
  180.  do dec(GlobalPath[0]);
  181.  
  182. assign(f,GlobalPath+'OT_XXX.');
  183. reset(f);
  184. OTfileFound:=(IOresult=0);
  185. IF NOT OTfileFound
  186.  then begin
  187.       writeln('WARNING: OT_XXX. file with object types not found.');
  188.       writeln('         A limited number of object type descriptions will be shown.');
  189.       writeln;
  190.       end;
  191.  
  192. If NOT ({IpxInitialize and} IsShellLoaded)
  193.  then begin
  194.       writeln('Error: Scanbind requires:');
  195.       writeln('       -IPX to be loaded;');
  196.       writeln('       -The Netware Shell to be loaded.');
  197.       halt(1);
  198.       end;
  199. GetBinderyAccessLevel(SecAccessLevel,MyObjId);
  200. write('All objects with a read security level <= ');
  201. WriteReadSecurity(SecAccessLevel); writeln(' will be shown.');
  202. writeln;
  203.  
  204. { put all objects in a table}
  205. lastObjSeen:=-1;
  206. PstartObj:=NIL;
  207.  
  208. While ScanBinderyObject('*',OT_WILD,lastObjSeen,
  209.                         objName,objType,objID,objFlag,objSec,objHasProp)
  210.   do PutInLinkedList(objId,objName,objType);
  211.  
  212. if nwBindry.Result<>$FC { no such object }
  213.  then writeln('Error Scanning Objects: $',HexStr(nwBindry.Result,2));
  214.  
  215.  
  216. { show all objects and asociated properties/values:}
  217. lastObjSeen:=-1;
  218.  
  219. While ScanBinderyObject('*',OT_WILD,lastObjSeen,
  220.                         objName,objType,objID,objFlag,objSec,objHasProp)
  221. do begin
  222.    writeln(HexStr(objId,8),' ',objName);
  223.  
  224.    write('The object type is :');
  225.    Case objType of
  226.       OT_UNKNOWN                     :writeln('Unknown Object Type ');
  227.       OT_USER                        :writeln('User ');
  228.       OT_USER_GROUP                  :writeln('User group ');
  229.       OT_PRINT_QUEUE                 :writeln('Print Queue ');
  230.       OT_FILE_SERVER                 :writeln('Fileserver ');
  231.       OT_JOB_SERVER                  :writeln('Jobserver ');
  232.       OT_GATEWAY                     :writeln('Gateway ');
  233.       OT_PRINT_SERVER                :writeln('Printserver ');
  234.       OT_ARCHIVE_QUEUE               :writeln('Archive Queue ');
  235.       OT_ARCHIVE_SERVER              :writeln('Archive Server ');
  236.       OT_JOB_QUEUE                   :writeln('Job Queue ');
  237.       OT_ADMINISTRATION              :writeln('Administration Object');
  238.       OT_RSPCX_SERVER                :writeln('RSPCX Server (Rconsole) ');
  239.       else begin
  240.            if OTfileFound
  241.             then begin
  242.                  reset(f);
  243.                  ObjTypeStr:=HexStr(objType,4);
  244.                  REPEAT
  245.                  readln(f,s);
  246.                  UNTIL eof(f) or (pos(ObjTypeStr,s)=1);
  247.                  if pos(ObjTypeStr,s)=1
  248.                   then begin
  249.                        delete(s,1,5);
  250.                        writeln(s);
  251.                        end;
  252.                  end
  253.             else writeln('objType= 0x',HexStr(objType,4),' (unknown)');
  254.            end;
  255.    end; {case}
  256.  
  257.    Case objFlag of
  258.     0:writeln('The object is a static object.');
  259.     1:writeln('The object is a dynamic object.');
  260.     else writeln('Unknown objectFlag:',objFlag);
  261.    end; {case}
  262.  
  263.    write('Security: Read: ');WriteReadSecurity(objSec);
  264.    write(' / Write: ');WriteWriteSecurity(objSec); writeln;
  265.  
  266.    if objHasProp
  267.     then begin
  268.          SeqNumber:=-1;
  269.          writeln('The object has the following properties:');
  270.  
  271.          While ScanProperty({in}  objName,objType,'*',
  272.                             {i/o} SeqNumber,
  273.                             {out} propName,propFlags,propSecurity,
  274.                                   propHasValue,moreProperties)
  275.          do begin
  276.             write('  ',propName);
  277.  
  278.             if HiNibble(propFlags)=0
  279.              then write ('  (Static')   { 0 }
  280.              else write ('  (Dynamic');  { 1 }
  281.  
  282.             Case LoNibble(propFlags) of
  283.              BF_ITEM:writeln(' Item-Property)');
  284.              BF_SET :writeln(' Set-Property)');
  285.              else writeln(' property), Property type=  ',LoNibble(propFlags),' (Unknown, not Item or Set)');
  286.             end; {case}
  287.  
  288.             write('    Security: Read: ');WriteReadSecurity(propSecurity);
  289.             write(' /Write: ');WriteWriteSecurity(propSecurity); writeln;
  290.  
  291.           { show value of properties: }
  292.             if propHasValue
  293.              then begin
  294.                   if LoNibble(propFlags)=BF_SET
  295.                    then begin
  296.                         SegNbr:=1;
  297.  
  298.                         While ReadPropertyValue(objName,objType,propName,SegNbr,
  299.                                                 propValue,moreSeg,propFlags)
  300.                          do begin
  301.                             ShowSet(propValue);
  302.                             inc(SegNbr);
  303.                             end;
  304.                         If nwBindry.Result<>$EC { no such segment }
  305.                          then writeln('Error Reading Property Values: $',
  306.                                        HexStr(nwBindry.Result,2));
  307.                         end
  308.                    else begin { item property }
  309.                         if propName='IDENTIFICATION'
  310.                          then begin
  311.                               getRealUserName(objName,tempString);
  312.                               writeln('    *',tempString)
  313.                               end
  314.                         else if propname='Q_DIRECTORY'
  315.                          then begin
  316.                               { asciiz string in 1st seg }
  317.                               SegNbr:=1;
  318.                               IF ReadPropertyValue(objName,objType,propName,SegNbr,
  319.                                                    propValue,moreSeg,propFlags)
  320.                               then begin
  321.                                    ZStrCopy(tempString,propValue,127);
  322.                                    writeln('    *',tempString);
  323.                                    end
  324.                               end
  325.                         else if propname='ACCOUNT_BALANCE'
  326.                          then begin
  327.                               { conversion of 1st 4 bytes to longint }
  328.                               SegNbr:=1;
  329.                               IF ReadPropertyValue(objName,objType,propName,SegNbr,
  330.                                                    propValue,moreSeg,propFlags)
  331.                                then writeln('    * Balance:',Lswap(accVal.balance),' Limit: ',Lswap(accVal.Limit));
  332.                               end
  333.                         else if propname='ACCOUNT_HOLDS'
  334.                          then begin
  335.                               SegNbr:=1;
  336.                               IF ReadPropertyValue(objName,objType,propName,SegNbr,
  337.                                                    propValue,moreSeg,propFlags)
  338.                               then begin
  339.                                    holds:=0;
  340.                                    for t:=1 to 16
  341.                                     do if holdVal[t].AccountServerID<>0
  342.                                        then holds:=holds+Lswap(holdVal[t].HoldAmount);
  343.                                    writeln('    * Total holds:',holds)
  344.                                    end;
  345.                               end
  346.                          else begin { structure not known, dump it }
  347.                               SegNbr:=1;
  348.                               While ReadPropertyValue(objName,objType,propName,SegNbr,
  349.                                                       propValue,moreSeg,propFlags)
  350.                                do begin
  351.                                   inc(segNbr);
  352.                                   DumpPropVal(moreSeg,propValue);
  353.                                   end;
  354.  
  355.                               If nwBindry.Result<>$EC { no such segment }
  356.                                 then writeln('Error Reading Property Values: $',
  357.                                              HexStr(nwBindry.Result,2));
  358.                               end
  359.  
  360.                         end;
  361.                   end {if propHasValue then }
  362.              else begin { prop has NO value }
  363.                   writeln('    *<property has no value>');
  364.                   end;
  365.             end; { While scanProperty do }
  366.  
  367.          If nwBindry.Result<>$FB { no such property }
  368.           then writeln('Error Scanning Properties: $',HexStr(nwBindry.Result,2));
  369.          end { if objHasProp then }
  370.     else begin { object has NO properties }
  371.          writeln('  <object has no properties>');
  372.          end;
  373.  
  374.    writeln;
  375.    end;  { While scanObject }
  376. if nwBindry.Result<>$FC { no such object }
  377.  then writeln('Error Scanning Objects: $',HexStr(nwBindry.Result,2));
  378.  
  379. IF OTfileFound
  380.  then close(f);
  381. end.
  382.